library(tidyverse)
library(knitr)
library(textreuse)
# Definimos los textos
textos<-c("Este es el ejemplo 1","Este es el ejemplo 2")
# Función para extraer las tejas
shingle_chars <- function(string, k, lowercase = FALSE){
# Extrae tejas de tamaño k para el string
tokenizers::tokenize_character_shingles(string, n = k, lowercase = FALSE,
simplify = TRUE, strip_non_alphanum = FALSE)
}
# Extraemos las tejas
tejas_textos <- map(textos, shingle_chars, k = 3)
# Imprimimos las tejas
tejas_textos
## [[1]]
## [1] "Est" "ste" "te " "e e" " es" "es " "s e" " el" "el " "l e" " ej"
## [12] "eje" "jem" "emp" "mpl" "plo" "lo " "o 1"
##
## [[2]]
## [1] "Est" "ste" "te " "e e" " es" "es " "s e" " el" "el " "l e" " ej"
## [12] "eje" "jem" "emp" "mpl" "plo" "lo " "o 2"
# Calculamos la intersección (num)
num<-intersect(tejas_textos[[1]],tejas_textos[[2]])
length(num)
## [1] 17
# Calculamos la unión (denom)
denom<-union(tejas_textos[[1]],tejas_textos[[2]])
length(denom)
## [1] 19
# Calculamos la similitud de Jaccard
sim_jaccard<-length(num)/length(denom)
sim_jaccard
## [1] 0.8947368
Considera la siguiente matriz de tejas-documentos:
mat <- matrix(c(0,1,0,1,0,1,0,0,1,0,0,1,0,0,1,0,0,0,1,1,1,0,0,0),
nrow = 6, byrow = TRUE)
colnames(mat) <- c('d_1','d_2','d_3','d_4')
rownames(mat) <- c(0,1,2,3,4,5)
mat
## d_1 d_2 d_3 d_4
## 0 0 1 0 1
## 1 0 1 0 0
## 2 1 0 0 1
## 3 0 0 1 0
## 4 0 0 1 1
## 5 1 0 0 0
Recuerda que \(a \mod 6\) es el residuo que se obtiene al dividir a entre \(6\), por ejemplo \(14 \mod 6 = 2\), y usa la numeración de renglones comenzando en \(0\).
Evaluamos las funciones hash en los renglones: \[ \begin{array}{c|ccc} r & h_1 & h_2 & h_3\\ \hline 0 & 1 & 2 & 2 \\ 1 & 3 & 5 & 1 \\ 2 & 5 & 2 & 0 \\ 3 & 1 & 5 & 5 \\ 4 & 3 & 2 & 4 \\ 5 & 5 & 5 & 3 \\ \hline \end{array} \]
Inicio del algoritmo:
\[ SIG= \begin{bmatrix} \infty & \infty & \infty & \infty \\ \infty & \infty & \infty & \infty \\ \infty & \infty & \infty & \infty \end{bmatrix} \]
Renglon \(0\):
Tenemos 1’s en la columna 2 y 4, por lo tanto hay que comparar:
\[ col2=min\left\lbrace\begin{pmatrix} \infty \\ \infty \\ \infty \\ \end{pmatrix},\begin{pmatrix} 1 \\ 2 \\ 2\\ \end{pmatrix}\right\rbrace=\begin{pmatrix} 1 \\ 2 \\ 2\\ \end{pmatrix}\qquad \text{y} \qquad col4=min\left\lbrace\begin{pmatrix} \infty \\ \infty \\ \infty \\ \end{pmatrix},\begin{pmatrix} 1 \\ 2 \\ 2\\ \end{pmatrix}\right\rbrace = \begin{pmatrix} 1 \\ 2 \\ 2\\ \end{pmatrix} \]
entonces
\[ SIG_0= \begin{bmatrix} \infty & 1 & \infty & 1 \\ \infty & 2 & \infty & 2 \\ \infty & 2 & \infty & 2 \end{bmatrix} \]
Renglon \(1\):
Tenemos 1’s sólo en la columna 2 por lo tanto hay que comparar:
\[ col1=min\left\lbrace\begin{pmatrix} 1 \\ 2 \\ 2 \\ \end{pmatrix},\begin{pmatrix} 3 \\ 5 \\ 1\\ \end{pmatrix}\right\rbrace = \begin{pmatrix} 1 \\ 2 \\ 1\\ \end{pmatrix} \]
entonces
\[ SIG_1= \begin{bmatrix} \infty & 1 & \infty & 1 \\ \infty & 2 & \infty & 2 \\ \infty & 1 & \infty & 2 \end{bmatrix} \]
Renglon \(2\):
Tenemos 1’s en la columna 1 y 4 por lo tanto hay que comparar:
\[ col1=min\left\lbrace\begin{pmatrix} \infty \\ \infty \\ \infty \\ \end{pmatrix},\begin{pmatrix} 5 \\ 2 \\ 0\\ \end{pmatrix}\right\rbrace=\begin{pmatrix} 5 \\ 2 \\ 0\\ \end{pmatrix}\qquad \text{y} \qquad col4=min\left\lbrace\begin{pmatrix} 1 \\ 2 \\ 2 \\ \end{pmatrix},\begin{pmatrix} 5 \\ 2 \\ 0\\ \end{pmatrix}\right\rbrace=\begin{pmatrix} 1 \\ 2 \\ 0\\ \end{pmatrix} \]
entonces
\[ SIG_2= \begin{bmatrix} 5 & 1 & \infty & 1 \\ 2 & 2 & \infty & 2 \\ 0 & 1 & \infty & 0 \end{bmatrix} \]
Renglon \(3\):
Tenemos 1’s sólo en la columna 3, por lo tanto hay que comparar:
\[ col3=min\left\lbrace\begin{pmatrix} \infty \\ \infty \\ \infty \\ \end{pmatrix},\begin{pmatrix} 1 \\ 5 \\ 5\\ \end{pmatrix}\right\rbrace=\begin{pmatrix} 1 \\ 5 \\ 5\\ \end{pmatrix} \]
entonces
\[ SIG_3= \begin{bmatrix} 5 & 1 & 1 & 1 \\ 2 & 2 & 5 & 2 \\ 0 & 1 & 5 & 0 \end{bmatrix} \]
Renglon \(4\):
Tenemos 1’s sólo en la columna 3 y 4, por lo tanto hay que comparar:
\[ col3=min\left\lbrace\begin{pmatrix} 1 \\ 5 \\ 5\\ \end{pmatrix},\begin{pmatrix} 3 \\ 2 \\ 4\\ \end{pmatrix}\right\rbrace=\begin{pmatrix} 1 \\ 2 \\ 4\\ \end{pmatrix}\qquad \text{y} \qquad col4=min\left\lbrace\begin{pmatrix} 1 \\ 2 \\ 0 \\ \end{pmatrix},\begin{pmatrix} 3 \\ 2 \\ 4\\ \end{pmatrix}\right\rbrace=\begin{pmatrix} 1 \\ 2 \\ 0\\ \end{pmatrix} \]
entonces
\[ SIG_4= \begin{bmatrix} 5 & 1 & 1 & 1 \\ 2 & 2 & 2 & 2 \\ 0 & 1 & 4 & 0 \end{bmatrix} \]
Renglon \(5\):
Tenemos 1’s sólo en la columna 1, por lo tanto hay que comparar:
\[ col1=min\left\lbrace\begin{pmatrix} 5 \\ 2 \\ 0\\ \end{pmatrix},\begin{pmatrix} 5 \\ 5 \\ 3\\ \end{pmatrix}\right\rbrace=\begin{pmatrix} 5 \\ 2 \\ 0\\ \end{pmatrix} \]
entonces
\[ SIG_5= \begin{bmatrix} 5 & 1 & 1 & 1 \\ 2 & 2 & 2 & 2 \\ 0 & 1 & 4 & 0 \end{bmatrix} \]
Primero definimos las funciones hash del ejercicio:
# Funciones Hash
# Nota se resta un uno a x para que los renglones empiecen en 0.
h1 <- function(x){(2*(x-1) +1) %% 6}
h2 <- function(x){(3*(x-1) +2) %% 6}
h3 <- function(x){(5*(x-1) +2) %% 6}
# Hacemos una lista con las funciones.
hash_f<-list(h1,h2,h3)
** Algoritmo por renglón**
Escribimos el arlgoritmo para extraer las firmas con funciones hash en lugar de permutaciones por renglón:
# Función para calcular firmas de documentos con
# funciones hash en lugar de permutaciones.
calc_firmas_hash <- function(mat_df, hash_f){
# Extrae el no. de funciones
num_hashes <- length(hash_f)
# Inicializa la matriz de firmas en infinitos.
# No. de filas = no. permutaciones (hashes), no. de columnas = no. documentos.
firmas <- matrix(Inf, ncol = ncol(mat_df), nrow = num_hashes)
# Para cada fila de la matriz de tejas:
for(r in 1:nrow(mat_df)){
# Extrae las columnas distintas de cero.
indices <- mat_df[r, ] > 0
# Selecciona el mínimo (elemento a elemento) entre el valor de la matriz de firmas y
# El valor de la función hash en r
firmas[, indices] <- pmin(firmas[, indices], map_dbl(hash_f, ~.(r)))
}
# Devuelve las firmas.
firmas
}
# Calculamos la matriz de firmas
firmas_renglon<-calc_firmas_hash(mat,hash_f)%>% as_data_frame()
colnames(firmas_renglon)<-paste("Doc",1:4,sep="_")
# Matriz de firmas
firmas_renglon
## # A tibble: 3 x 4
## Doc_1 Doc_2 Doc_3 Doc_4
## <dbl> <dbl> <dbl> <dbl>
## 1 5 1 1 1
## 2 2 2 2 2
## 3 0 1 4 0
y vemos que obtuvimos el mismo restuldado que haciendo el ejercicio a mano.
** Algoritmo por columna (documento)**
Escribimos el arlgoritmo para extraer las firmas con funciones hash en lugar de permutaciones por documento:
# Funciones Hash
# Nota se resta un uno a x para que los renglones empiecen en 0.
h1 <- function(x){(2*(x) +1) %% 6}
h2 <- function(x){(3*(x) +2) %% 6}
h3 <- function(x){(5*(x) +2) %% 6}
# Hacemos una lista con las funciones.
hash_f<-list(h1,h2,h3)
# Función para crear tejas por documento
crear_tejas_doc <- function(mat){
# Se extrae el no de documentos
num_docs <- ncol(mat)
# crear tejas únicas por documento
tejas <- apply(mat,2,function(x){rownames(mat)[which(x==1)]})
# Dataframe con documento y tejass
tejas_df <- data_frame(texto_id = 1:num_docs, shingles = tejas) %>%
unnest %>% #se conviert a data frame
group_by(texto_id) %>% # se agrupa por documento
summarise(shingles = list(shingles)) # se hace una lista de las tejas
# Lista de salida con tejas, no de doc. y tamaño de tejas
list(tejas = tejas_df$shingles, num_docs = num_docs)
}
# Función para calcular firmas de documentos con
# funciones hash en lugar de permutaciones por documento
calc_firmas_hash_doc <- function(tejas_doc, hash_f){
# Extrae el no. de documentos
num_docs <- tejas_doc$num_docs
# Extrae el no. de hashes
num_hashes<-length(hash_f)
# Extraen las tejas
tejas<-lapply(tejas_doc$tejas,as.numeric)
# Inicializa la matriz de firmas en infinitos.
# No. de filas = no. permutaciones (hashes), no. de columnas = no. documentos.
firmas <- vector("list",num_docs)
# Para cada fila de la matriz de tejas:
for(i in 1:num_docs){
# El valor de la función hash en r
firmas[[i]] <- map_dbl(hash_f, ~ min(.x(tejas[[i]])))
}
# Se crea un data frame
firmas
}
# Obtenemos las tejas por documento
tejas_doc<-crear_tejas_doc(mat)
# Calculamos la matriz de firmas
firmas_columna<-calc_firmas_hash_doc(tejas_doc,hash_f)%>%
unlist()%>%
matrix(ncol=4,nrow=3,byrow=FALSE)%>%
as_data_frame()
colnames(firmas_columna)<-paste("Doc",1:4,sep="_")
# Matriz de firmas
firmas_columna
## # A tibble: 3 x 4
## Doc_1 Doc_2 Doc_3 Doc_4
## <dbl> <dbl> <dbl> <dbl>
## 1 5 1 1 1
## 2 2 2 2 2
## 3 0 1 4 0
y vemos que obtenemos un resultado distinto.
Sólo \(h_3\) es una verdadera permutación de los renglones pues es la única que mapea cada renglón a un numero del 0 al 5 distinto. Las funciones \(h_1\) y \(h_2\) mapean distintos renglones al mismo número.
# Calculamos similitudes verdaderas
Sim_Jaccard<-data_frame(Docs=paste("Doc",c(1,1,1,2,2,3)," vs Doc",c(2,3,4,3,4,4),sep=""),
SJ_Verdadera=c(length(which(mat[,1] == 1 & mat[,2]==1))/length(which(mat[,1] == 1 | mat[,2]==1)),
length(which(mat[,1] == 1 & mat[,3]==1))/length(which(mat[,1] == 1 | mat[,3]==1)),
length(which(mat[,1] == 1 & mat[,4]==1))/length(which(mat[,1] == 1 | mat[,4]==1)),
length(which(mat[,2] == 1 & mat[,3]==1))/length(which(mat[,2] == 1 | mat[,3]==1)),
length(which(mat[,2] == 1 & mat[,4]==1))/length(which(mat[,2] == 1 | mat[,4]==1)),
length(which(mat[,3] == 1 & mat[,4]==1))/length(which(mat[,3] == 1 | mat[,4]==1))),
SJ_MH_Renglon=c(mean(firmas_renglon$Doc_1 == firmas_renglon$Doc_2),
mean(firmas_renglon$Doc_1 == firmas_renglon$Doc_3),
mean(firmas_renglon$Doc_1 == firmas_renglon$Doc_4),
mean(firmas_renglon$Doc_2 == firmas_renglon$Doc_3),
mean(firmas_renglon$Doc_2 == firmas_renglon$Doc_4),
mean(firmas_renglon$Doc_3 == firmas_renglon$Doc_4)),
SJ_MH_Columna=c(mean(firmas_columna$Doc_1 == firmas_columna$Doc_2),
mean(firmas_columna$Doc_1 == firmas_columna$Doc_3),
mean(firmas_columna$Doc_1 == firmas_columna$Doc_4),
mean(firmas_columna$Doc_2 == firmas_columna$Doc_3),
mean(firmas_columna$Doc_2 == firmas_columna$Doc_4),
mean(firmas_columna$Doc_3 == firmas_columna$Doc_4)))
# Imprimimos las comparación
DT::datatable(Sim_Jaccard%>%
mutate_if(is.numeric, funs(round(., 3))))
textreuse::hash_string("a")
## [1] 1424956863
textreuse::hash_string("Este es el ejemplo 1")
## [1] 487152643
textreuse::hash_string("Este es el ejemplo 2")
## [1] -1235446691
Nota: la implmentación en c++ está vacía, por lo tanto dependiendo de la computadora puede dar distintos hashes. Si usamos todos el docker, debemos obtener el mismo valor. Para evitar esto podemos usar las funciones digest.
digest::digest("Este es el ejemplo 1","xxhash32") # el segundo argumento es el tipo de algoritmo.
## [1] "998c5fad"
# digest::digest("Este es el ejemplo 1","xxhash32")%>%stroi(16) # el segundo argumento es el tipo de algoritmo.
Estos son más robustos en el sentido de que no tienen patrones.
# Definimos el texto
texto1<-"Este es el ejemplo 1"
# Calculamos las tejas
tejas_texto1 <-map(texto1, shingle_chars, k = 3)
# Sacamos los hashes
result_texto1<-data_frame(tejas=unlist(tejas_texto1),
hashes=lapply(tejas_texto1,hash_string)%>%unlist)
DT::datatable(result_texto1)
minhash1<-min(result_texto1$hashes)
minhash1
## [1] -1851510203
# Definimos el texto
texto2<-"Este es otro ejemplo"
# Calculamos las tejas
tejas_texto2 <-map(texto2, shingle_chars, k = 3)
# Sacamos los hashes
result_texto2<-data_frame(tejas=unlist(tejas_texto2),
hashes=lapply(tejas_texto2,hash_string)%>%unlist)
DT::datatable(result_texto2)
minhash2<-min(result_texto2$hashes)
minhash2
## [1] -1792124468
La similitud es distinta por lo tanto, la similitud de jaccard sería cero.
Primero leemos los tweets
# Ruta de los datos
ruta <- "../datos/FIFA.csv"
# ruta google storage para descargar los datos.
gc_ruta <- "https://storage.googleapis.com/fifa_tweets/FIFA.csv"
if(!file.exists(ruta)){
# si el archivo no existe, descarga los datos.
download.file(gc_ruta, ruta)
} else {
# si el archivo existe, carga los datoss.
fifa <- read_csv("../datos/FIFA.csv")
}
# Extrae los tweets
tw <- fifa$Tweet
# No. de tweets
length(tw)
## [1] 530000
Creamos funciones para extaer tejas por renglon, para generar hashs modulares y para calcular la matriz de firmas
# genera las funciones minhash
minhash<-minhash_generator(15)
# Lee los tweets, genera tejas de tamaño 5 y evalua los minhashes.
system.time(
corpus_tweets <- TextReuseCorpus(text = tw[1:10000], # 200 mil tweets
tokenizer = shingle_chars, k = 5, lowercase = FALSE, # tejas de tamaño 5
hash_func = minhash, keep_tokens = TRUE, # minhas generados
keep_text = TRUE, skip_short = FALSE)
)
## user system elapsed
## 8.680 0.010 8.698
# Extrae las firmas por documento
min_hashes<-hashes(corpus_tweets)
# Generamos una partición. Como cada documento tiene 15 hashes,
# hacemos la partición de 3 en 3
particion <- split(1:15, ceiling(1:15 / 5))
particion
## $`1`
## [1] 1 2 3 4 5
##
## $`2`
## [1] 6 7 8 9 10
##
## $`3`
## [1] 11 12 13 14 15
# Función para separar cubetas
separar_cubetas_fun <- function(particion){
function(firma){
map_chr(particion, function(x){
# Junta los elementos de la partición
prefijo <- paste0(x, collapse = '')
# Pega la firma con comas (porque hay negativos)
cubeta <- paste(firma[x], collapse = ",")
# Pega los elementos de la partición y la firma.
paste(c(prefijo, cubeta), collapse = '|')
})
}
}
# Evaluamos la función para separar cubetas en la partición definida
sep_cubetas <- separar_cubetas_fun(particion)
# Extrae id de documento y la cubeta correspondiente.
firmas_2<-data_frame(doc_id=names(lapply(min_hashes,sep_cubetas)),
cubeta=lapply(min_hashes, sep_cubetas))%>%
unnest()%>%
mutate(doc_id=as.integer(substring(doc_id,5)))
head(firmas_2)
## # A tibble: 6 x 2
## doc_id cubeta
## <int> <chr>
## 1 1 12345|-2125737498,-2136530979,-2091585088,-2086910194,-2115473948
## 2 1 678910|-2113881230,-2117311400,-2135384632,-2143332867,-2063876239
## 3 1 1112131415|-2105559740,-2044384905,-2104902737,-2076339721,-21312…
## 4 2 12345|-2083853123,-2131756023,-2099559639,-2116536287,-2147090977
## 5 2 678910|-2145985888,-2129736039,-2117185203,-2115022534,-2076298834
## 6 2 1112131415|-2137973117,-2062006948,-2135166998,-2075896645,-21291…
# Se agrupa por cubeta y se listan los documentos en cada uno
cubetas_df <- firmas_2 %>% group_by(cubeta) %>%
summarise(docs = list(doc_id)) %>%
mutate(n_docs = map_int(docs, length))
# Se filtran las cubetas con más de un elemento
candidatos <- cubetas_df %>% filter(n_docs > 1)
head(candidatos)
## # A tibble: 6 x 3
## cubeta docs n_docs
## <chr> <list> <int>
## 1 1112131415|-1021556167,-1063070020,-1863022675,-19493555… <int [4… 4
## 2 1112131415|-1042813698,-427041255,-131236858,-1490843395… <int [8… 8
## 3 1112131415|-1049412994,-944327104,-2093451695,-208405030… <int [6… 6
## 4 1112131415|-1054016222,-779239123,-1943575713,-199952790… <int [2… 2
## 5 1112131415|-1068989404,-418072893,-1715247100,-959603457… <int [2… 2
## 6 1112131415|-1091764408,-1716466257,-2080068295,-17536826… <int [6… 6
# Función para extraer pares de similitud alta
extraer_pares <- function(candidatos, cubeta, docs, textos = NULL){
enq_cubeta <- enquo(cubeta)
enq_docs <- enquo(docs)
pares <- candidatos %>%
mutate(pares = map(!!enq_docs, ~ combn(sort(.x), 2, simplify = FALSE))) %>% # Genera pares de documentos de los listados en candidatos
select(!!enq_cubeta, pares) %>% unnest %>%
mutate(a = map_int(pares, 1)) %>%
mutate(b = map_int(pares, 2)) %>%
select(-pares) %>% select(-!!enq_cubeta) %>% unique
if(!is.null(textos)){
pares <- pares %>% mutate(texto_a = textos[a], texto_b = textos[b])
}
pares
}
# se obtienen los pares similares
system.time(
pares_similares<-extraer_pares(candidatos, cubeta, docs, textos = tw[1:10000])%>% arrange(texto_a)
)
## user system elapsed
## 32.600 0.170 32.798
# No. de pares similares
nrow(pares_similares)
## [1] 280225
DT::datatable(pares_similares)
## Warning in instance$preRenderHook(instance): It seems your data is too
## big for client-side DataTables. You may consider server-side processing:
## https://rstudio.github.io/DT/server.html